home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / vmath10.zip / VMATH10.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-21  |  19KB  |  535 lines
  1. {-------------------------------->  Vmath  <---------------------------------}
  2. { This unit contains vector and matrix procedures and functions for TURBO-   }
  3. { PASCAL, partly written as inline assembler code for a 387 coprocessor.     }
  4. { They are about two to three times faster than the equivalent "pure PASCAL" }
  5. { code.                                                                      }
  6. { Known features/limitations/bugs etc.:                                      }
  7. { - The unit has been written with TP6.0 on an 386SX/IIT387SX machine        }
  8. { - The procedure MulM4V4 needs an IIT coprocessor                           }
  9. { - The 287 coprocessor needs additional FWAIT commands in of strategic      }
  10. {   places all over the code, since I don't have one I didn't bother.        }
  11. { - All routines PUSH DS on entry, use long pointers (You don't want to      }
  12. {   be limited to 64K won't You ?) for operand access and POP DS on exit     }
  13. { - No testing of the routines has been carried out except that they work    }
  14. {   fine and fast in my application - NO WARRANTY !                          }
  15. { - I wrote the routines as I needed them (or as I wanted to find out how to }
  16. {   do it, in the case of MulM4V4) but at least the Vector3 operations are   }
  17. {   quite complete by now. If I find the time some more Matrix3 code may     }
  18. {   follow.                                                                  }
  19. {----------------------------------------------------------------------------}
  20. { These routines contain no special artifice, but are straightforward        }
  21. { coded "mathematical common knowledge", so everybody is free to copy        }
  22. { and modify the whole unit or parts of it. And remember: Distributing       }
  23. { sourcecode advances the "Art of Computing" by allowing others to learn     }
  24. { from Your mistakes !                                                       }
  25. {----------------------------------------------------------------------------}
  26. { I would be pleased to get some feedback (comments/additions/questions or   }
  27. { even a sample application using this unit) from users of Vmath -preferably }
  28. { via Email - Internet: mowl@cc.flinders.edu.au                              }
  29. {                                                                            }
  30. {     _--_|\                     Wolfgang Lieff                              }
  31. {    /      \  Flinders Institute for Atmospheric and Marine Sciences        }
  32. {    \_.--x_/          Bedford Park , South Australia 5042                   }
  33. {          v                                                                 }
  34. {----------------------------------------------------------------------------}
  35. { Version 1.0 of 20/05/1991 by Wolfgang Lieff                                }
  36. {----------------------------------------------------------------------------}
  37. unit Vmath10;
  38.  
  39. interface
  40.  
  41. type Matrix4  = array[0..3,0..3] of double;
  42.      Vector4  = array[0..3] of double;
  43.      Matrix3  = array[0..2,0..2] of double;
  44.      Vector3  = array[0..2] of double;
  45.  
  46. const
  47.   ZeroV3   : Vector3 = (0.0,0.0,0.0);
  48.   XunityV3 : Vector3 = (1.0,0.0,0.0);
  49.   YunityV3 : Vector3 = (0.0,1.0,0.0);
  50.   ZunityV3 : Vector3 = (0.0,0.0,1.0);
  51.  
  52. {----------------------------------------------------------------------------}
  53. procedure DirectionV3(P1,P2:Vector3; var R:Vector3);
  54. {         ===========                                                        }
  55. {         Function     Calculates the unity direction vector from P1 to P2   }
  56. {                                                                            }
  57. {         Result type  Vector3                                               }
  58. {----------------------------------------------------------------------------}
  59. procedure MulV3V3(V1,V2:Vector3; var R:Vector3);
  60. {         =======                                                            }
  61. {         Function     Multiplies the components of two vectors              }
  62. {                                                                            }
  63. {         Result type  Vector3                                               }
  64. {----------------------------------------------------------------------------}
  65. function  MulV3(V1,V2:Vector3):double;
  66. {         =====                                                              }
  67. {         Function     Scalar multiplication (dot product) of two vectors    }
  68. {                                                                            }
  69. {         Result type  double                                                }
  70. {----------------------------------------------------------------------------}
  71. procedure CrossV3(V1,V2:Vector3; var R:Vector3);
  72. {         =======                                                            }
  73. {         Function     Vector multiplication (cross product) of two vectors  }
  74. {                                                                            }
  75. {         Result type  Vector3                                               }
  76. {----------------------------------------------------------------------------}
  77. procedure NormalizeV3(var V:Vector3);
  78. {         ===========                                                        }
  79. {         Function     Transforms a vector into a unity vector with the same }
  80. {                      direction                                             }
  81. {                                                                            }
  82. {         Result type  Vector                                                }
  83. {----------------------------------------------------------------------------}
  84. function  AbsV3(V:Vector3):double;
  85. {         =====                                                              }
  86. {         Function     Returns the length of a vector                        }
  87. {                                                                            }
  88. {         Result type  double                                                }
  89. {----------------------------------------------------------------------------}
  90. function  QuickAbsV3(V:Vector3):double;
  91. {         ==========                                                         }
  92. {         Function     Returns a rough estimate of the length of a vector    }
  93. {                      by simply adding the absolute values of the components}
  94. {                                                                            }
  95. {         Result type  double                                                }
  96. {----------------------------------------------------------------------------}
  97. procedure MulV3D(V:Vector3; S:double; var R:Vector3);
  98. {         ======                                                             }
  99. {         Function     Multiplies the components of a vector with a scalar   }
  100. {                                                                            }
  101. {         Result type  Vector3                                               }
  102. {----------------------------------------------------------------------------}
  103. procedure DivV3D(V:Vector3; S:double; var R:Vector3);
  104. {         ======                                                             }
  105. {         Function     Divides the components of a vector by a scalar        }
  106. {                                                                            }
  107. {         Result type  double                                                }
  108. {----------------------------------------------------------------------------}
  109. procedure DivV3V3(V1,V2:Vector3; R:Vector3);
  110. {         =======                                                            }
  111. {         Function     Divides the components of two vectors                 }
  112. {                                                                            }
  113. {         Result type  double                                                }
  114. {----------------------------------------------------------------------------}
  115. procedure AddV3(V1,V2:Vector3; var R:Vector3);
  116. {         =====                                                              }
  117. {         Function     Adds two vectors                                      }
  118. {                                                                            }
  119. {         Result type  Vector3                                               }
  120. {----------------------------------------------------------------------------}
  121. procedure SubV3(V1,V2:Vector3; var R:Vector3);
  122. {         =====                                                              }
  123. {         Function     Subtracts two vectors                                 }
  124. {                                                                            }
  125. {         Result type  Vector3                                               }
  126. {----------------------------------------------------------------------------}
  127. procedure DtoV3(X,Y,Z:double; var V:Vector3);
  128. {         =====                                                              }
  129. {         Function     Copies three scalars into the components of a vector  }
  130. {                                                                            }
  131. {         Result type  Vector3                                               }
  132. {----------------------------------------------------------------------------}
  133. procedure InvertV3(var V:Vector3);
  134. {         ========                                                           }
  135. {         Function     Inverts the sign of all vector components             }
  136. {                                                                            }
  137. {         Result type  Vector3                                               }
  138. {----------------------------------------------------------------------------}
  139. procedure RandomUnitV3(var V:Vector3);
  140. {         ============                                                       }
  141. {         Function     Generates a random unit vector                        }
  142. {                                                                            }
  143. {         Result type  Vector3                                               }
  144. {----------------------------------------------------------------------------}
  145. procedure MulM4V4 (A:Matrix4; B:Vector4; var C:Vector4);
  146. {         =======                                                            }
  147. {         Function     Multiplies a 4x4 matrix with a 4-element vector       }
  148. {                                                                            }
  149. {         Result type  Vector4                                               }
  150. {                                                                            }
  151. {         Remark       Uses the register page switching and matrix functions }
  152. {                      of the IIT coprocessors                               }
  153. {----------------------------------------------------------------------------}
  154. function Det3V3(V1,V2,V3:Vector3):double;
  155. {        ======                                                              }
  156. {         Function     Calculates the determinant of a matrix who's columns  }
  157. {                      are formed by three vectors                           }
  158. {                                                                            }
  159. {         Result type  double                                                }
  160. {----------------------------------------------------------------------------}
  161. implementation
  162.  
  163. procedure MulM4V4(A:Matrix4; B:Vector4; var C:Vector4); assembler;
  164. asm
  165.   PUSH DS
  166.   FINIT
  167.   LDS    SI,dword ptr A
  168.   DW     $EBDB               { The first IIT switch opcode }
  169.   FLD    qword ptr[SI+$10]
  170.   FLD    qword ptr[SI+$30]
  171.   FLD    qword ptr[SI+$50]
  172.   FLD    qword ptr[SI+$70]
  173.   FLD    qword ptr[SI+$18]
  174.   FLD    qword ptr[SI+$38]
  175.   FLD    qword ptr[SI+$58]
  176.   FLD    qword ptr[SI+$78]
  177.   FINIT
  178.   DW     $EADB               { The second IIT switch opcode }
  179.   FLD    qword ptr[SI]
  180.   FLD    qword ptr[SI+$20]
  181.   FLD    qword ptr[SI+$40]
  182.   FLD    qword ptr[SI+$60]
  183.   FLD    qword ptr[SI+$08]
  184.   FLD    qword ptr[SI+$28]
  185.   FLD    qword ptr[SI+$48]
  186.   FLD    qword ptr[SI+$68]
  187.   FINIT
  188.   LDS    SI,dword ptr B
  189.   DW     $E8DB               { And the last IIT switch opcode }
  190.   FLD    qword ptr[SI+$18]
  191.   FLD    qword ptr[SI+$10]
  192.   FLD    qword ptr[SI+$08]
  193.   FLD    qword ptr[SI]
  194.   LDS    SI,dword ptr C
  195.   DW     $F1DB               { This IIT opcode triggers the operation }
  196.   FSTP   qword ptr[SI]
  197.   FSTP   qword ptr[SI+$08]
  198.   FSTP   qword ptr[SI+$10]
  199.   FSTP   qword ptr[SI+$18]
  200.   POP    DS
  201. end;
  202.  
  203.  
  204. function Det3V3(V1,V2,V3:Vector3):double; assembler;
  205. asm
  206.   PUSH   DS
  207.   LDS    SI,dword ptr V3
  208.   FLD    qword ptr[SI+$10]
  209.   FLD    qword ptr[SI+$08]
  210.   LDS    SI,dword ptr V2
  211.   FLD    qword ptr[SI+$10]
  212.   FLD    qword ptr[SI+$08]
  213.   FMULP  ST(3),ST(0)
  214.   FMULP  ST(1),ST(0)
  215.   FSUBP  ST(1),ST(0)
  216.   LDS    SI,dword ptr V1
  217.   FLD    qword ptr [SI]
  218.   FMULP  ST(1),ST(0)  
  219.   FLD    qword ptr [SI+$08]
  220.   FLD    qword ptr [SI+$10]
  221.   LDS    SI,dword ptr V3
  222.   FLD    qword ptr [SI+$08]
  223.   FLD    qword ptr [SI+$10]
  224.   FMULP  ST(3),ST(0)
  225.   FMULP  ST(1),ST(0)
  226.   FSUBP  ST(1),ST(0)
  227.   LDS    SI,dword ptr V2
  228.   FLD    qword ptr [SI]
  229.   FMULP  ST(1),ST(0)
  230.   FSUBP  ST(1),ST(0)   
  231.   LDS    SI,dword ptr V2
  232.   FLD    qword ptr [SI+$10]
  233.   FLD    qword ptr [SI+$08]
  234.   LDS    SI,dword ptr V1
  235.   FLD    qword ptr [SI+$10]
  236.   FLD    qword ptr [SI+$08]
  237.   FMULP  ST(3),ST(0)
  238.   FMULP  ST(1),ST(0)
  239.   FSUBP  ST(1),ST(0)
  240.   LDS    SI,dword ptr V3
  241.   FLD    qword ptr [SI]
  242.   FMULP  ST(1),ST(0)
  243.   FADDP  ST(1),ST(0)
  244.   POP    DS
  245. end;
  246.  
  247.  
  248. procedure InvertV3(var V:Vector3); assembler;
  249. asm
  250.   PUSH   DS
  251.   PUSH   AX
  252.   LDS    SI,dword ptr V
  253.   MOV    AL,$80
  254.   XOR    [SI+$07],AL
  255.   XOR    [SI+$0F],AL
  256.   XOR    [SI+$17],AL
  257.   POP    AX
  258.   POP    DS
  259. end;
  260.  
  261.  
  262. procedure DtoV3(X,Y,Z:double; var V:Vector3); assembler;
  263. asm
  264.   PUSH   DS
  265.   LDS    SI,dword ptr  V
  266.   FLD    X
  267.   FSTP   qword ptr [SI]
  268.   FLD    Y
  269.   FSTP   qword ptr [SI+$08]
  270.   FLD    Z
  271.   FSTP   qword ptr [SI+$10]
  272.   POP    DS
  273. end;
  274.  
  275.  
  276.  
  277. procedure SubV3(V1,V2:Vector3; var R:Vector3); assembler;
  278. asm
  279.   PUSH   DS
  280.   LDS    SI,dword ptr V1
  281.   FLD    qword ptr[SI]
  282.   FLD    qword ptr[SI+$08]
  283.   FLD    qword ptr[SI+$10]
  284.   LDS    SI,dword ptr V2
  285.   FLD    qword ptr[SI]
  286.   FLD    qword ptr[SI+$08]
  287.   FLD    qword ptr[SI+$10]
  288.   FSUBP  ST(3),ST(0)
  289.   FSUBP  ST(3),ST(0)
  290.   FSUBP  ST(3),ST(0)
  291.   LDS    SI,dword ptr R
  292.   FSTP   qword ptr[SI+$10]
  293.   FSTP   qword ptr[SI+$08]
  294.   FSTP   qword ptr[SI]
  295.   POP    DS
  296. end;
  297.  
  298.  
  299. procedure AddV3(V1,V2:Vector3; var R:Vector3); assembler;
  300. asm
  301.   PUSH   DS
  302.   LDS    SI,dword ptr V1
  303.   FLD    qword ptr[SI]
  304.   FLD    qword ptr[SI+$08]
  305.   FLD    qword ptr[SI+$10]
  306.   LDS    SI,dword ptr V2
  307.   FLD    qword ptr[SI]
  308.   FLD    qword ptr[SI+$08]
  309.   FLD    qword ptr[SI+$10]
  310.   FADDP  ST(3),ST(0)
  311.   FADDP  ST(3),ST(0)
  312.   FADDP  ST(3),ST(0)
  313.   LDS    SI,dword ptr R
  314.   FSTP   qword ptr[SI+$10]
  315.   FSTP   qword ptr[SI+$08]
  316.   FSTP   qword ptr[SI]
  317.   POP    DS
  318. end;
  319.  
  320.  
  321. procedure MulV3V3(V1,V2:Vector3; var R:Vector3); assembler;
  322. asm
  323.   PUSH   DS
  324.   LDS    SI,dword ptr V1
  325.   FLD    qword ptr[SI]
  326.   FLD    qword ptr[SI+$08]
  327.   FLD    qword ptr[SI+$10]
  328.   LDS    SI,dword ptr V2
  329.   FLD    qword ptr[SI]
  330.   FLD    qword ptr[SI+$08]
  331.   FLD    qword ptr[SI+$10]
  332.   FMULP  ST(3),ST(0)
  333.   FMULP  ST(3),ST(0)
  334.   FMULP  ST(3),ST(0)
  335.   LDS    SI,dword ptr R
  336.   FSTP   qword ptr[SI+$10]
  337.   FSTP   qword ptr[SI+$08]
  338.   FSTP   qword ptr[SI]
  339.   POP    DS
  340. end;
  341.  
  342.  
  343. procedure DivV3V3(V1,V2:Vector3; R:Vector3);  assembler;
  344. asm
  345.   PUSH   DS
  346.   LDS    SI,dword ptr V1
  347.   FLD    qword ptr[SI]
  348.   FLD    qword ptr[SI+$08]
  349.   FLD    qword ptr[SI+$10]
  350.   LDS    SI,dword ptr V2
  351.   FLD    qword ptr[SI]
  352.   FLD    qword ptr[SI+$08]
  353.   FLD    qword ptr[SI+$10]
  354.   FDIVP  ST(3),ST(0)
  355.   FDIVP  ST(3),ST(0)
  356.   FDIVP  ST(3),ST(0)
  357.   LDS    SI,dword ptr R
  358.   FSTP   qword ptr[SI+$10]
  359.   FSTP   qword ptr[SI+$08]
  360.   FSTP   qword ptr[SI]
  361.   POP    DS
  362. end;
  363.  
  364.  
  365. procedure MulV3D(V:Vector3; S:double; var R:Vector3); assembler;
  366. asm
  367.   PUSH   DS
  368.   LDS    SI,dword ptr V
  369.   FLD    qword ptr[SI]
  370.   FLD    qword ptr[SI+$08]
  371.   FLD    qword ptr[SI+$10]
  372.   FLD    S
  373.   FMUL   ST(3),ST(0)
  374.   FMUL   ST(2),ST(0)
  375.   FMULP  ST(1),ST(0)
  376.   LDS    SI,dword ptr R
  377.   FSTP   qword ptr[SI+$10]
  378.   FSTP   qword ptr[SI+$08]
  379.   FSTP   qword ptr[SI]
  380.   POP    DS
  381. end;
  382.  
  383. procedure DivV3D(V:Vector3; S:double; var R:Vector3); assembler;
  384. asm
  385.   PUSH   DS
  386.   LDS    SI,dword ptr V
  387.   FLD    qword ptr[SI]
  388.   FLD    qword ptr[SI+$08]
  389.   FLD    qword ptr[SI+$10]
  390.   FLD    S
  391.   FDIV   ST(3),ST(0)
  392.   FDIV   ST(2),ST(0)
  393.   FDIVP  ST(1),ST(0)
  394.   LDS    SI,dword ptr R
  395.   FSTP   qword ptr[SI+$10]
  396.   FSTP   qword ptr[SI+$08]
  397.   FSTP   qword ptr[SI]
  398.   POP    DS
  399. end;
  400.  
  401.  
  402. function AbsV3(V:Vector3):double; assembler;
  403. asm
  404.   PUSH   DS
  405.   LDS    SI,dword ptr V
  406.   FLD    qword ptr[SI]
  407.   FLD    ST(0)
  408.   FMULP  ST(1),ST(0)
  409.   FLD    qword ptr[SI+$08]
  410.   FLD    ST(0)
  411.   FMULP  ST(1),ST(0)
  412.   FADDP  ST(1),ST(0)
  413.   FLD    qword ptr[SI+$10]
  414.   FLD    ST(0)
  415.   FMULP  ST(1),ST(0)
  416.   FADDP  ST(1),ST(0)
  417.   FSQRT
  418.   POP    DS
  419. end;
  420.  
  421. function QuickAbsV3(V:Vector3):double; assembler;
  422. asm
  423.   PUSH   DS
  424.   LDS    SI,dword ptr V
  425.   FLD    qword ptr[SI]
  426.   FABS
  427.   FLD    qword ptr[SI+$08]
  428.   FABS
  429.   FADDP  ST(1),ST(0)
  430.   FLD    qword ptr[SI+$10]
  431.   FABS
  432.   FADDP  ST(1),ST(0)
  433.   POP    DS
  434. end;
  435.  
  436.  
  437. procedure NormalizeV3(var V:Vector3); assembler;
  438. asm
  439.   PUSH   DS
  440.   LDS    SI,dword ptr V
  441.   FLD    qword ptr[SI]
  442.   FLD    qword ptr[SI+$08]
  443.   FLD    qword ptr[SI+$10]
  444.   FLD    ST(2)
  445.   FLD    ST(0)
  446.   FMULP  ST(1),ST(0)
  447.   FLD    ST(2)
  448.   FLD    ST(0)
  449.   FMULP  ST(1),ST(0)
  450.   FADDP  ST(1),ST(0)
  451.   FLD    ST(1)
  452.   FLD    ST(0)
  453.   FMULP  ST(1),ST(0)
  454.   FADDP  ST(1),ST(0)
  455.   FSQRT
  456.   FDIV   ST(3),ST(0)
  457.   FDIV   ST(2),ST(0)
  458.   FDIVP  ST(1),ST(0)
  459.   FSTP   qword ptr[SI+$10]
  460.   FSTP   qword ptr[SI+$08]
  461.   FSTP   qword ptr[SI]
  462.   POP    DS
  463. end;
  464.  
  465.  
  466. function MulV3(V1,V2:Vector3):double;  assembler;
  467. asm
  468.   PUSH   DS
  469.   LDS    SI,dword ptr V1
  470.   FLD    qword ptr[SI]
  471.   FLD    qword ptr[SI+$08]
  472.   FLD    qword ptr[SI+$10]
  473.   LDS    SI,dword ptr V2
  474.   FLD    qword ptr[SI]
  475.   FLD    qword ptr[SI+$08]
  476.   FLD    qword ptr[SI+$10]
  477.   FMULP  ST(3),ST(0)
  478.   FMULP  ST(3),ST(0)
  479.   FMULP  ST(3),ST(0)
  480.   FADDP  ST(1),ST(0)
  481.   FADDP  ST(1),ST(0)
  482.   POP    DS
  483. end;
  484.  
  485.  
  486. procedure CrossV3(V1,V2:Vector3; var R:Vector3); assembler;
  487. asm
  488.   PUSH   DS
  489.   LDS    SI,dword ptr V1
  490.   FLD    qword ptr[SI]
  491.   FLD    qword ptr[SI+$08]
  492.   FLD    qword ptr[SI+$10]
  493.   LDS    SI,dword ptr V2
  494.   FLD    qword ptr[SI]
  495.   FLD    qword ptr[SI+$08]
  496.   FLD    qword ptr[SI+$10]
  497.   LDS    SI,dword ptr R
  498.   FLD    ST(4)
  499.   FMUL   ST(0),ST(1)
  500.   FLD    ST(2)
  501.   FMUL   ST(0),ST(5)
  502.   FSUBP  ST(1),ST(0)
  503.   FSTP   qword ptr[SI]
  504.   FLD    ST(3)
  505.   FMUL   ST(0),ST(3)
  506.   FLD    ST(6)
  507.   FMUL   ST(0),ST(2)
  508.   FSUBP  ST(1),ST(0)
  509.   FSTP   qword ptr[SI+$08]
  510.   FLD    ST(5)
  511.   FMUL   ST(0),ST(2)
  512.   FLD    ST(3)
  513.   FMUL   ST(0),ST(6)
  514.   FSUBP  ST(1),ST(0)
  515.   FSTP   qword ptr[SI+$10]
  516.   FINIT
  517.   POP    DS
  518. end;
  519.  
  520. procedure DirectionV3(P1,P2:Vector3; var R:Vector3);
  521. begin
  522.   SubV3(P2,P1,R);
  523.   NormalizeV3(R);
  524. end;
  525.  
  526. procedure RandomUnitV3(var V:Vector3);
  527. begin
  528.   DtoV3(Random-0.5,Random-0.5,Random-0.5,V);
  529.   NormalizeV3(V);
  530. end;
  531.  
  532.  
  533. end.
  534.  
  535.